home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / pc / LOGIC Apple II 5.25" Library - DOS Part 3 / DOS066.dsk / CALORIE RQMTS.bas < prev    next >
BASIC Source File  |  2012-02-16  |  4KB  |  86 lines
  1. 1  POKE 33,40
  2. 2  HOME 
  3. 10  PRINT : PRINT "PROGRAM FOR THE DETERMINATION OF ADULT": PRINT "         ENERGY REQUIREMENTS"
  4. 15  PRINT 
  5. 20  PRINT "RESPONSES SHOULD BE A LETTER OR NUMBER": PRINT "FOLLOWED BY A CARRIAGE RETURN"
  6. 30  PRINT 
  7. 40  INPUT "ARE YOU MALE (M) OR FEMALE (F)? ";SX$
  8. 50 SX =  ASC(SX$): IF SX < >70  AND SX < >77 GOTO 40
  9. 60  INPUT "WHAT IS YOUR AGE IN YEARS?";AG
  10. 70  IF AG <19  THEN  PRINT "SORRY, I DON'T WORK FOR AGES LESS THAN": PRINT "  20": END 
  11. 80  PRINT "MEASUREMENTS MAY BE IN KG/CM OR LB/IN "
  12. 85  PRINT 
  13. 90  INPUT "DO YOU USE ENGLISH (E) OR METRIC (M)? ";MS$
  14. 100 MS =  ASC(MS$): IF MS < >69  AND MS < >77 GOTO 90
  15. 105  PRINT 
  16. 110  INPUT "WEIGHT (LB/KG) UNDRESSED ";WT
  17. 115  PRINT 
  18. 120  INPUT "HEIGHT (IN/CM) W/O SHOES ";HT
  19. 125  PRINT 
  20. 130  INPUT "PRESENT IDEAL WEIGHT     ";IW
  21. 135  PRINT 
  22. 140  IF MS = 69  THEN WT = WT *.454:HT = HT *2.54:IW = IW *.454
  23. 150  IF WT <40  OR WT >125  THEN  PRINT "SORRY, NOT ACCURATE FOR YOUR WEIGHT": END 
  24. 160  IF HT <140  OR WT >200  THEN  PRINT "SORRY, NOT ACCURATE FOR YOUR HEIGHT": END 
  25. 170  PRINT : PRINT "HOW MANY HOURS PER DAY ARE SPENT DOING": PRINT " THE FOLLOWING:  "
  26. 175  PRINT 
  27. 180  INPUT "SLEEPING - ";A1: INPUT "LYING DOWN AWAKE - ";A2
  28. 190  INPUT "SITTING OR STANDING - ";A3
  29. 200  PRINT "LIGHT ACTIVITY E.G. COOKING OR        ": INPUT "WALKING - ";A4
  30. 210  INPUT "MODERATE ACTIVITY E.G. ACTIVE WORK - ";A5
  31. 220  INPUT "HEAVY ACTIVITY E.G. RUNNING - ";A6
  32. 230 TA = A1 +A2 +A3 +A4 +A5 +A6
  33. 240  IF TA <22  OR TA >26  THEN  PRINT "DOES NOT ADD UP TO ONE DAY!!!": GOTO 170
  34. 245  PRINT 
  35. 250  PRINT "AVERAGE DIETS HAVE ABOUT 15% OF THEIR  ": PRINT "CALORIES AS PROTEIN."
  36. 255  PRINT 
  37. 260  INPUT "WHAT PERCENT OF YOURS IS PROTEIN - ";DP
  38. 265  PRINT 
  39. 270  IF DP <0  OR DP >100 GOTO 260
  40. 280 PF = 1.06 +(DP -15)/100 *.28
  41. 290 FC = 0:PC = 0:PW = 0
  42. 300  IF SX = 77 GOTO 430: REM  FEMALE CALCULATIONS FOLLOW
  43. 310  INPUT "ARE YOU PREGNANT? ";PR$
  44. 320  IF  ASC(PR$) < >89 GOTO 360
  45. 325  PRINT 
  46. 330  INPUT "HOW MANY WEEKS POST CONCEPTION? ";PC
  47. 335  PRINT 
  48. 340  IF PC >10  THEN PW = .454 *(PC -10):FC = 300: REM  PG CORRECTIONS
  49. 350  GOTO 390
  50. 360  INPUT "ARE YOU LACTATING? ";LC$
  51. 370  IF  ASC(LC$) = 89  THEN FC = 500: GOTO 390: REM  LACTATION CORRECTIONS
  52. 380  IF  ASC(PR$) < >78  OR  ASC(LC$) < >78 GOTO 310
  53. 390 BM = 655 +9.6 *WT +1.8 *HT -4.7 *AG: REM   BAS METABOLIC RATE CALCULATION 
  54. 400 AF = (.9 *A1 +A2 +1.3 *A3 +2.6 *A4 +4.1 *A5 +8 *A6)/TA: REM  ACTIVITY FACTOR
  55. 410 CW = .00192 *HT ^2 +.0448 *HT +PW: REM  CALCULATION OF OPTIMAL WEIGHT, CW(HT)
  56. 420  GOTO 460: REM  SKIP MALE CALCULATIONS
  57. 430 BM = 67 +13.8 *WT +5.0 *HT -6.8 *AG
  58. 440 AF = (.9 *A1 +A2 +1.5 *A3 +2.9 *A4 +4.3 *A5 +8.4 *A6)/TA
  59. 450 CW = .00177 *HT ^2 +.088 *HT
  60. 460  REM  A PRECISION STATEMENT NOT IN MICROSOFT BASIC
  61. 470  PRINT "YOUR CALCULATIONS FOLLOW": PRINT : PRINT "BASAL METABOLIC RATE -     "; INT(BM +FC +.5)" CALORIES "
  62. 480 KC = (AF *BM +FC) *PF
  63. 490  PRINT "AVG. CALORIE REQUIREMENT - "; INT(KC +.5)" CALORIES"
  64. 495  PRINT 
  65. 500  PRINT "STATED IDEAL WEIGHT MINUS ACTUAL WEIGHT"
  66. 510  PRINT IW;"-";WT;" = "; INT(100 *(IW -WT) +.5)/100" KG OR "; INT(100 *(IW -WT)/.454 +.5)/100" LBS"
  67. 515  PRINT 
  68. 520  PRINT "IDEAL WEIGHT FOR YOUR HEIGHT - ": PRINT  INT(100 *CW +.5)/100" KG OR " INT(100 *CW/.454 +.5)/100" LBS +/- 10%"
  69. 525  PRINT 
  70. 530  IF PC >10  THEN  PRINT "THIS INCLUDES A " INT(PW *100 +.5)/100" KG OR " INT(PW *100/.454 +.5)/100" LB ": PRINT "ADDITION FOR A PREGNANCY OF "PC" WEEKS"
  71. 540  IF IW -WT = 0  THEN  END 
  72. 545  PRINT 
  73. 550  INPUT "DO YOU WISH A DIET SCHEDULE ";DI$
  74. 560  IF  ASC(DI$) = 78  THEN  END 
  75. 570  IF  ASC(DI$) < >89 GOTO 550
  76. 580  PRINT "AN OFTEN RECOMMENDED GOAL FOR WEIGHT": PRINT "CHANGE IS 0.5 KG (1 LB) / WEEK"
  77. 585  PRINT 
  78. 590  PRINT "HOW MANY WEEKS DO YOU WISH TO MAKE THE": INPUT "DIET FOR? ";DT
  79. 600  IF DT = 0  THEN  END 
  80. 605  PRINT 
  81. 610  PRINT "DAILY INTAKE SHOULD BE " INT(KC)" + " INT((IW -WT) *1100 *PF/DT)" = ": PRINT  INT(KC +(IW -WT) *1100 *PF/DT)" CALORIES FOR " SGN((IW -WT)/DT) * ABS( INT((IW -WT)/DT *100 +.5)/100)" KG/WK"
  82. 615  PRINT 
  83. 620  PRINT "THIS ASSUMES THAT YOUR CALORIC INTAKE ": PRINT "IS STILL "DP"% PROTEIN"
  84. 625  PRINT 
  85. 630  IF PC >0  THEN  PRINT "PREGNANCY WILL ALTER THE RESULTS,": PRINT "CHECK WITH YOUR DOCTOR"
  86. 640  END